home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / xf2.3-p / xf2 / xf2.3 / additionals / Hypertext < prev    next >
Encoding:
Text File  |  1993-11-20  |  16.5 KB  |  480 lines
  1. # Program: xf
  2. # Description: handle hypertext widgets
  3. #
  4. # $Header: Hypertext[2.3] Wed Mar 10 11:57:22 1993 garfield@garfield frozen $
  5.  
  6. global xfDefaultConf
  7. set xfDefaultConf(hypertext) 5
  8.  
  9. ##########
  10. # Procedure: XFAdd.Hypertext
  11. # Description: add a hypertext
  12. # Arguments: xfW - the widget
  13. #            xfName - a optional name
  14. #            xfType - add or config
  15. # Returns: none
  16. # Sideeffects: none
  17. ##########
  18. proc XFAdd.Hypertext {xfW xfName xfType} {
  19.   global xfConf
  20.   global xfStatus
  21.  
  22.   XFEditSetStatus "Inserting Hypertext..."
  23.   set xfName [XFMiscGetUniqueName $xfName hypertext]
  24.   if {"$xfStatus(path)" == "."} {
  25.     if {"$xfType" == "add"} {
  26.       if {[catch "htext .$xfName" xfResult]} {
  27.         XFProcError "$xfResult"
  28.         XFEditSetStatus "Inserting Hypertext...aborted"
  29.         return
  30.       }
  31.     } {
  32.       if {[catch "htext .$xfName" xfResult]} {
  33.         XFProcError "$xfResult"
  34.         XFEditSetStatus "Inserting Hypertext...aborted"
  35.         return
  36.       }
  37.     }
  38.  
  39.     XFMiscPositionWidget .$xfName
  40.     XFMiscBindWidgetTree .$xfName
  41.   } {
  42.     if {"$xfType" == "add"} {
  43.       if {[catch "htext $xfStatus(path).$xfName" xfResult]} {
  44.         XFProcError "$xfResult"
  45.         XFEditSetStatus "Inserting Hypertext...aborted"
  46.         return
  47.       }
  48.     } {
  49.       if {[catch "htext $xfStatus(path).$xfName" xfResult]} {
  50.         XFProcError "$xfResult"
  51.         XFEditSetStatus "Inserting Hypertext...aborted"
  52.         return
  53.       }
  54.     }
  55.  
  56.     XFMiscPositionWidget $xfStatus(path).$xfName
  57.     XFMiscBindWidgetTree $xfStatus(path).$xfName
  58.   }
  59.  
  60.   incr xfStatus(elementCounter)
  61.   XFEditSetPath $xfStatus(path)
  62.   XFEditSetStatus "Inserting Hypertext...done"
  63. }
  64.  
  65. ##########
  66. # Procedure: XFAddTmp.Hypertext
  67. # Description: add a tmp hypertext
  68. # Arguments: none
  69. # Returns: none
  70. # Sideeffects: none
  71. ##########
  72. proc XFAddTmp.Hypertext {} {
  73.  
  74.   catch "destroy .xfEdit.tmplt"
  75.   if {[catch "htext .xfEdit.tmplt"]} {
  76.     XFProcConfConfigure undefined "" "" Hypertext add
  77.   } {
  78.     XFProcConfConfigure .xfEdit.tmplt "" "" Hypertext add
  79.   }
  80. }
  81.  
  82. ##########
  83. # Procedure: XFBind.Hypertext
  84. # Description: default bindings for hypertext
  85. # Arguments: xfW - the widget
  86. # Returns: none
  87. # Sideeffects: none
  88. ##########
  89. proc XFBind.Hypertext {xfW} {
  90.  
  91.   if {"[info commands $xfW]" != ""} {
  92.     bind $xfW <2> {%W scan mark %x %y}
  93.     bind $xfW <B2-Motion> {%W scan dragto %x %y}
  94.     bind $xfW <Control-p> {%W gotoline [expr [%W gotoline]-1]}
  95.     bind $xfW <Control-n> {%W gotoline [expr [%W gotoline]+1]}
  96.   }
  97. }
  98.  
  99. ##########
  100. # Procedure: XFConfig.Hypertext4
  101. # Description: configure a hypertext
  102. # Arguments: xfW - the widget
  103. #            xfType - config type (add config)
  104. #            xfClass - the class we configure
  105. #            xfLeader - the leading window
  106. # Returns: none
  107. # Sideeffects: none
  108. ##########
  109. proc XFConfig.Hypertext4 {xfW xfType xfClass {xfLeader ""}} {
  110.   global xfMisc
  111.   global xfStatus
  112.  
  113.   if {"$xfType" == "add"} {
  114.     set xfName hypertext$xfStatus(elementCounter)
  115.   } {
  116.     set xfName [XFMiscPathName $xfW]
  117.   }
  118.   XFEditSetStatus "Calling parameter setting for Hypertext..."
  119.  
  120.   # build widget structure
  121.   XFTmpltToplevel .xf${xfClass}Config4 400x510 \
  122.     "Hypertext parameters:[XFMiscPathTail $xfW]" $xfLeader
  123.  
  124.   XFElementInit $xfW .xf${xfClass}Config4 $xfType $xfClass \
  125.     XFHypertextSetHypertext4 parameters $xfName 4
  126.   XFElementColor $xfW .xf${xfClass}Config4 $xfType $xfClass bg \
  127.     background Background "Background" XFHypertextSetHypertext4
  128.   XFElementFont $xfW .xf${xfClass}Config4 $xfType $xfClass \
  129.     font font Font "Font" XFHypertextSetHypertext4
  130.   XFElementColor $xfW .xf${xfClass}Config4 $xfType $xfClass fg \
  131.     foreground Foreground "Foreground" XFHypertextSetHypertext4
  132.   XFElementGeometry $xfW .xf${xfClass}Config4 $xfType $xfClass \
  133.     XFHypertextSetHypertext4
  134.   XFElementScale $xfW .xf${xfClass}Config4 $xfType $xfClass linespacing \
  135.     linespacing LineSpacing "Line spacing" "pixels" 40 \
  136.     XFHypertextSetHypertext4
  137.   XFElementText $xfW .xf${xfClass}Config4 $xfType $xfClass specialchar \
  138.     specialchar SpecialChar "Special character" XFHypertextSetHypertext4
  139.   XFElementText $xfW .xf${xfClass}Config4 $xfType $xfClass xscrollcommand \
  140.     xscrollcommand XScrollCommand "X scroll command" XFHypertextSetHypertext4
  141.   XFElementScale $xfW .xf${xfClass}Config4 $xfType $xfClass xscrollunits \
  142.     xScrollUnits ScrollUnits "X scroll units" "pixels" 400 \
  143.     XFHypertextSetHypertext4
  144.   XFElementText $xfW .xf${xfClass}Config4 $xfType $xfClass yscrollcommand \
  145.     yscrollcommand YScrollCommand "Y scroll command" XFHypertextSetHypertext4
  146.   XFElementScale $xfW .xf${xfClass}Config4 $xfType $xfClass yscrollunits \
  147.     xScrollUnits ScrollUnits "Y scroll units" "pixels" 400 \
  148.     XFHypertextSetHypertext4
  149.  
  150.   # save current parameter
  151.   XFElementSave $xfW $xfClass {background font foreground geometry linespacing specialchar xscrollcommand xscrollunits xscrollcommand xscrollunits}
  152.  
  153.   # packing
  154.   pack append .xf${xfClass}Config4.params1 \
  155.               .xf${xfClass}Config4.params1.params2 {left fill expand}
  156.   pack append .xf${xfClass}Config4 \
  157.               .xf${xfClass}Config4.pathname {top fill frame center} \
  158.               .xf${xfClass}Config4.leave {bottom fill} \
  159.               .xf${xfClass}Config4.additional {bottom fill} \
  160.               .xf${xfClass}Config4.params1 {top fill expand}
  161.  
  162.   XFBindFormConnect .xf${xfClass}Config4.params1.params2 \
  163.     "XFHypertextSetHypertext4 $xfW 0 $xfClass"
  164.  
  165.   XFEditSetStatus "Calling parameter setting for Hypertext...done"
  166. }
  167.  
  168. ##########
  169. # Procedure: XFConfig.Hypertext5
  170. # Description: configure a hypertext
  171. # Arguments: xfW - the widget
  172. #            xfType - config type (add config)
  173. #            xfClass - the class we configure
  174. #            xfLeader - the leading window
  175. # Returns: none
  176. # Sideeffects: none
  177. ##########
  178. proc XFConfig.Hypertext5 {xfW xfType xfClass {xfLeader ""}} {
  179.   global xfBind
  180.   global xfMisc
  181.   global xfStatus
  182.  
  183.   set xfName [XFMiscPathName $xfW]
  184.   XFEditSetStatus "Calling parameter setting for Hypertext..."
  185.  
  186.   # build widget structure
  187.   XFTmpltToplevel .xf${xfClass}Config5 400x540 \
  188.     "Hypertext parameters:[XFMiscPathTail $xfW]" $xfLeader
  189.  
  190.   XFElementInit $xfW .xf${xfClass}Config5 $xfType $xfClass \
  191.     XFHypertextSetHypertext5 parameters $xfName 5
  192.   XFElementText $xfW .xf${xfClass}Config5 $xfType $xfClass filename \
  193.     filename FileName "File name" XFHypertextSetHypertext5
  194.  
  195.   label .xf${xfClass}Config5.params1.params2.childMess \
  196.     -anchor c \
  197.     -text "Hypertext children:"
  198.  
  199.   XFTmpltListbox .xf${xfClass}Config5.params1.params2 childs
  200.   .xf${xfClass}Config5.params1.params2.childs.childs configure \
  201.     -geometry 20x10
  202.   foreach xfCounter [winfo children $xfW] {
  203.     .xf${xfClass}Config5.params1.params2.childs.childs insert end $xfCounter
  204.   }
  205.  
  206.   label .xf${xfClass}Config5.params1.params2.textMess \
  207.     -anchor c \
  208.     -text "Text (write to the file to keep contents!):"
  209.  
  210.   if {"$xfType" == "add"} {
  211.     XFTmpltText .xf${xfClass}Config5.params1.params2 text 0
  212.   } {
  213.     XFTmpltText .xf${xfClass}Config5.params1.params2 text 0 \
  214.       [lindex [$xfW configure -text] 4]
  215.   }
  216.   set xfFileName \
  217.     [.xf${xfClass}Config5.params1.params2.filename.filename get]
  218.   if {"$xfFileName" != ""} {
  219.     if {[file exists $xfFileName]} {
  220.       if {![catch "open $xfFileName r" xfInFile]} {
  221.         set xfText ""
  222.         while {1} {
  223.           if {[gets $xfInFile xfLine] == -1} {
  224.             break
  225.           }
  226.           append xfText "$xfLine\n"
  227.         }
  228.         close $xfInFile
  229.         XFMiscSetText .xf${xfClass}Config5.params1.params2.text.text "$xfText"
  230.       }
  231.     }
  232.   }
  233.  
  234.   XFTmpltFrame .xf${xfClass}Config5.params1.params2.actions 0
  235.  
  236.   button .xf${xfClass}Config5.params1.params2.actions.insert \
  237.     -text {Insert widget} \
  238.     -command "XFHypertextInsert $xfW $xfClass"
  239.  
  240.   button .xf${xfClass}Config5.params1.params2.actions.rescan \
  241.     -text {Rescan} \
  242.     -command "
  243.       XFMiscClearList .xf${xfClass}Config5.params1.params2.childs.childs
  244.       foreach xfCounter \[winfo children $xfW\] {
  245.         .xf${xfClass}Config5.params1.params2.childs.childs insert end \$xfCounter
  246.       }"
  247.  
  248.   button .xf${xfClass}Config5.params1.params2.actions.save \
  249.     -text {Save} \
  250.     -command "
  251.       set xfFileName \
  252.         \[.xf${xfClass}Config5.params1.params2.filename.filename get\]
  253.       if {\"\$xfFileName\" != \"\"} {
  254.         if {\[catch \"open \$xfFileName w\" xfOutFile\]} {
  255.           XFProcError \"Cannot open \$xfFileName\"
  256.         } {
  257.           set xfTmpContents \
  258.             \[XFMiscGetText .xf${xfClass}Config5.params1.params2.text.text\]
  259.           puts \$xfOutFile \"\$xfTmpContents\"
  260.           close \$xfOutFile
  261.         }
  262.       } {
  263.         XFProcError \"No file name specified\"
  264.       }"
  265.  
  266.   .xf${xfClass}Config5.leave.ok configure \
  267.     -command "
  268.       set xfFileName \
  269.         \[.xf${xfClass}Config5.params1.params2.filename.filename get\]
  270.       XFMiscSetSymbolicName $xfW \
  271.         \[.xf${xfClass}Config5.params1.params2.symname.symname get\]
  272.       if {\"\$xfFileName\]\" != \"\"} {
  273.         if {\[catch \"open \$xfFileName w\" xfOutFile\]} {
  274.           XFProcError \"Cannot open \$xfFileName\"
  275.         } {
  276.           set xfTmpContents \
  277.             \[XFMiscGetText .xf${xfClass}Config5.params1.params2.text.text\]
  278.           puts \$xfOutFile \"\$xfTmpContents\"
  279.           close \$xfOutFile
  280.           XFHypertextSetHypertext5 $xfW 1 $xfClass
  281.           destroy .xf${xfClass}Config5
  282.         }
  283.       } {
  284.         XFProcError \"No file name specified (could not save)\"
  285.       }"
  286.  
  287.   .xf${xfClass}Config5.leave.cancel configure \
  288.     -command "destroy .xf${xfClass}Config5"
  289.  
  290.   # bindings
  291.   bind .xf${xfClass}Config5.params1.params2.childs.childs $xfBind(configure) {
  292.     XFBindSelectOne %W %y
  293.     XFMiscFlash [%W get [%W curselect]]
  294.     XFProcConfConfigure [%W get [%W curselect]]}
  295.   bind .xf${xfClass}Config5.params1.params2.childs.childs $xfBind(select1) "
  296.     XFBindSelectOne %W %y
  297.     XFMiscFlash \[%W get \[%W curselect\]\]
  298.     XFHypertextInsert $xfW $xfClass"
  299.   bind .xf${xfClass}Config5.params1.params2.childs.childs <ButtonPress-1> {
  300.     XFBindSelectOne %W %y
  301.     XFMiscFlash [%W get [%W curselect]]}
  302.   bind .xf${xfClass}Config5.params1.params2.childs.childs <Button1-Motion> {
  303.     XFBindSelectOne %W %y}
  304.   bind .xf${xfClass}Config5.params1.params2.childs.childs <Shift-ButtonPress-1> {
  305.     XFBindSelectOne %W %y}
  306.   bind .xf${xfClass}Config5.params1.params2.childs.childs <Shift-Button1-Motion> {
  307.     XFBindSelectOne %W %y}
  308.  
  309.   bind .xf${xfClass}Config5.params1.params2.filename.filename $xfBind(configure) \
  310.     "XFProcFSBoxFile {.xf${xfClass}Config5.params1.params2.filename.filename}"
  311.  
  312.   # packing
  313.   pack append .xf${xfClass}Config5.params1.params2.actions \
  314.               .xf${xfClass}Config5.params1.params2.actions.insert {left fill expand} \
  315.               .xf${xfClass}Config5.params1.params2.actions.save {left fill expand} \
  316.               .xf${xfClass}Config5.params1.params2.actions.rescan {left fill expand}
  317.   pack append .xf${xfClass}Config5.params1.params2 \
  318.               .xf${xfClass}Config5.params1.params2.actions {bottom fill} \
  319.               .xf${xfClass}Config5.params1.params2.childMess {top fillx padx 6} \
  320.               .xf${xfClass}Config5.params1.params2.childs {top fill} \
  321.               .xf${xfClass}Config5.params1.params2.textMess {top fillx padx 6} \
  322.               .xf${xfClass}Config5.params1.params2.text {top fill expand}
  323.   pack append .xf${xfClass}Config5.params1 \
  324.               .xf${xfClass}Config5.params1.params2 {left fill expand}
  325.   pack append .xf${xfClass}Config5 \
  326.               .xf${xfClass}Config5.pathname {top fill frame center} \
  327.               .xf${xfClass}Config5.leave {bottom fill} \
  328.               .xf${xfClass}Config5.additional {bottom fill} \
  329.               .xf${xfClass}Config5.params1 {top fill expand}
  330.  
  331.   XFBindFormConnect .xf${xfClass}Config5.params1.params2 \
  332.     "XFHypertextSetHypertext5 $xfW 0 $xfClass"
  333.  
  334.   XFEditSetStatus "Calling parameter setting for Hypertext...done"
  335. }
  336.  
  337. ##########
  338. # Procedure: XFHypertextInsert
  339. # Description: insert item into hypertext
  340. # Arguments: xfW - the widget we configure
  341. #            xfClass - the class we edit
  342. # Returns: none
  343. # Sideeffects: none
  344. ##########
  345. proc XFHypertextInsert {xfW xfClass} {
  346.  
  347.   set xfCurSelect \
  348.     [.xf${xfClass}Config5.params1.params2.childs.childs curselect]
  349.   if {$xfCurSelect >= 0} {
  350.     XFMiscInsertText .xf${xfClass}Config5.params1.params2.text.text \
  351.       "%%$xfW append [.xf${xfClass}Config5.params1.params2.childs.childs get $xfCurSelect]%%"
  352.   }
  353. }
  354.  
  355. ##########
  356. # Procedure: XFSaveWidget.Hypertext
  357. # Description: save hypertext widget
  358. # Arguments: xfOutFile - the output file
  359. #            xfW - the widget
  360. # Returns: none
  361. # Sideeffects: none
  362. ##########
  363. proc XFSaveWidget.Hypertext {xfOutFile xfW} {
  364.   global xfConf
  365.  
  366.   set xfType [string tolower [winfo class $xfW]]
  367.  
  368.   # what are we doing here ?
  369.   puts $xfOutFile "\n  # build widget $xfW"
  370.  
  371.   # write widget type and path name
  372.   puts $xfOutFile "  if {\[catch \"htext $xfW\"\]} {"
  373.   puts $xfOutFile "    if {\"\[info procs XFEdit\]\" != \"\"} {"
  374.   puts $xfOutFile "      XFProcError \"Unknown widget type: htext\""
  375.   puts $xfOutFile "      return"
  376.   puts $xfOutFile "    } {"
  377.   puts $xfOutFile "      puts stderr \"Unknown widget type: htext\""
  378.   puts $xfOutFile "      catch \"destroy .\""
  379.   puts $xfOutFile "      catch \"exit 0\""
  380.   puts $xfOutFile "    }"
  381.   puts $xfOutFile "  }"
  382.  
  383.   puts $xfOutFile "  $xfW config " nonewline
  384.   XFSaveWidgetResource $xfOutFile $xfW
  385.   puts $xfOutFile ""
  386. }
  387.  
  388. ##########
  389. # Procedure: XFHypertextSetHypertext4
  390. # Description: set hypertext parameters
  391. # Arguments: xfW - the widget
  392. #            xfType - the type of setting (1 = set always, 0 = set
  393. #                     only if permanent apply is on)
  394. #            xfClass - the class we configure
  395. #            xfParam1 - ignored parameter
  396. # Returns: none
  397. # Sideeffects: none
  398. ##########
  399. proc XFHypertextSetHypertext4 {xfW xfType xfClass {xfParam1 ""}} {
  400.   global xfConf
  401.   global xfMisc
  402.  
  403.   if {$xfType == 0 && !$xfConf(applyParameters)} {
  404.     return
  405.   }
  406.   if {"[info commands $xfW]" == ""} {
  407.     return
  408.   }
  409.   XFMiscSetSymbolicName $xfW \
  410.     [.xf${xfClass}Config4.params1.params2.symname.symname get]
  411.  
  412.   XFMiscSetResource $xfW background \
  413.     [.xf${xfClass}Config4.params1.params2.bg.bg get]
  414.   XFMiscSetResource $xfW font \
  415.     [.xf${xfClass}Config4.params1.params2.font.font get]
  416.   XFMiscSetResource $xfW foreground \
  417.     [.xf${xfClass}Config4.params1.params2.fg.fg get]
  418.   if {[.xf${xfClass}Config4.params1.params2.geo.geo1.geo1 get] > 0 &&
  419.       [.xf${xfClass}Config4.params1.params2.geo.geo2.geo2 get] > 0} {
  420.     XFMiscSetResource $xfW geometry \
  421.       "[.xf${xfClass}Config4.params1.params2.geo.geo1.geo1 get]x[.xf${xfClass}Config4.params1.params2.geo.geo2.geo2 get]"
  422.   }
  423.   XFMiscSetResource $xfW linespacing \
  424.     [.xf${xfClass}Config4.params1.params2.linespacing.linespacing get]
  425.   if {"[.xf${xfClass}Config4.params1.params2.specialchar.specialchar get]" != ""} {
  426.     XFMiscSetResource $xfW specialchar \
  427.       [.xf${xfClass}Config4.params1.params2.specialchar.specialchar get]
  428.   }
  429.   XFMiscSetResource $xfW xscrollcommand \
  430.     [.xf${xfClass}Config4.params1.params2.xscrollcommand.xscrollcommand get]
  431.   XFMiscSetResource $xfW xscrollunits \
  432.     [.xf${xfClass}Config4.params1.params2.xscrollunits.xscrollunits get]
  433.   XFMiscSetResource $xfW yscrollcommand \
  434.     [.xf${xfClass}Config4.params1.params2.yscrollcommand.yscrollcommand get]
  435.   XFMiscSetResource $xfW yscrollunits \
  436.     [.xf${xfClass}Config4.params1.params2.yscrollunits.yscrollunits get]
  437. }
  438.  
  439. ##########
  440. # Procedure: XFHypertextSetHypertext5
  441. # Description: set hypertext parameters
  442. # Arguments: xfW - the widget
  443. #            xfType - the type of setting (1 = set always, 0 = set
  444. #                     only if permanent apply is on)
  445. #            xfClass - the class we configure
  446. #            xfParam1 - ignored parameter
  447. # Returns: none
  448. # Sideeffects: none
  449. ##########
  450. proc XFHypertextSetHypertext5 {xfW xfType xfClass {xfParam1 ""}} {
  451.   global xfConf
  452.  
  453.   if {$xfType == 0 && !$xfConf(applyParameters)} {
  454.     return
  455.   }
  456.   if {"[info commands $xfW]" == ""} {
  457.     return
  458.   }
  459.   XFMiscSetSymbolicName $xfW \
  460.     [.xf${xfClass}Config5.params1.params2.symname.symname get]
  461.  
  462.   if {"[.xf${xfClass}Config5.params1.params2.filename.filename get]" != ""} {
  463.     XFMiscSetResource $xfW filename \
  464.       [.xf${xfClass}Config5.params1.params2.filename.filename get]
  465.     XFMiscClearText .xf${xfClass}Config5.params1.params2.text.text
  466.     XFMiscPutFileInText .xf${xfClass}Config5.params1.params2.text.text \
  467.       [.xf${xfClass}Config5.params1.params2.filename.filename get]
  468.     XFMiscClearList .xf${xfClass}Config5.params1.params2.childs.childs
  469.     foreach xfCounter [winfo children $xfW] {
  470.       .xf${xfClass}Config5.params1.params2.childs.childs insert end $xfCounter
  471.     }
  472.   } {
  473.     XFMiscSetResource $xfW text \
  474.       [XFMiscGetText .xf${xfClass}Config5.params1.params2.text.text]
  475.   }
  476. }
  477.  
  478. # eof
  479.  
  480.